home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / OldSrc / CH3 / SRC / GETENTRY.FRM < prev    next >
Text File  |  1996-05-01  |  5KB  |  177 lines
  1. VERSION 4.00
  2. Begin VB.Form GetEntryForm 
  3.    Caption         =   "GetEntry"
  4.    ClientHeight    =   3495
  5.    ClientLeft      =   1500
  6.    ClientTop       =   1260
  7.    ClientWidth     =   5910
  8.    Height          =   4185
  9.    Left            =   1440
  10.    LinkTopic       =   "Form1"
  11.    ScaleHeight     =   3495
  12.    ScaleWidth      =   5910
  13.    Top             =   630
  14.    Width           =   6030
  15.    Begin VB.TextBox EntryText 
  16.       BeginProperty Font 
  17.          name            =   "Courier New"
  18.          charset         =   1
  19.          weight          =   400
  20.          size            =   8.25
  21.          underline       =   0   'False
  22.          italic          =   0   'False
  23.          strikethrough   =   0   'False
  24.       EndProperty
  25.       Height          =   3495
  26.       Left            =   3480
  27.       MultiLine       =   -1  'True
  28.       ScrollBars      =   2  'Vertical
  29.       TabIndex        =   1
  30.       Top             =   0
  31.       Width           =   2415
  32.    End
  33.    Begin VB.PictureBox Pict 
  34.       AutoRedraw      =   -1  'True
  35.       Height          =   3495
  36.       Left            =   0
  37.       ScaleHeight     =   229
  38.       ScaleMode       =   3  'Pixel
  39.       ScaleWidth      =   221
  40.       TabIndex        =   0
  41.       Top             =   0
  42.       Width           =   3375
  43.    End
  44.    Begin MSComDlg.CommonDialog FileDialog 
  45.       Left            =   3240
  46.       Top             =   3120
  47.       _version        =   65536
  48.       _extentx        =   847
  49.       _extenty        =   847
  50.       _stockprops     =   0
  51.       cancelerror     =   -1  'True
  52.    End
  53.    Begin VB.Menu mnuFile 
  54.       Caption         =   "&File"
  55.       Begin VB.Menu mnuFileLoad 
  56.          Caption         =   "&Load..."
  57.          Shortcut        =   ^L
  58.       End
  59.       Begin VB.Menu mnuFileSep 
  60.          Caption         =   "-"
  61.       End
  62.       Begin VB.Menu mnuFileExit 
  63.          Caption         =   "E&xit"
  64.       End
  65.    End
  66. End
  67. Attribute VB_Name = "GetEntryForm"
  68. Attribute VB_Creatable = False
  69. Attribute VB_Exposed = False
  70. Option Explicit
  71.  
  72. ' ***********************************************
  73. ' Display a list of the colors in the logical
  74. ' palette.
  75. ' ***********************************************
  76. Sub ShowEntries()
  77. Dim num_entries As Integer
  78. Dim palentry(0 To 255) As PALETTEENTRY
  79. Dim i As Integer
  80. Dim txt As String
  81. Dim istr As String
  82. Dim rstr As String
  83. Dim gstr As String
  84. Dim bstr As String
  85.  
  86.     If Pict.Picture = 0 Then
  87.         EntryText.Text = "No picture loaded."
  88.         Exit Sub
  89.     ElseIf Pict.Picture.hPal = 0 Then
  90.         EntryText.Text = "Default palette."
  91.         Exit Sub
  92.     End If
  93.     
  94.     num_entries = GetPaletteEntries(Pict.Picture.hPal, 0, 256, palentry(0))
  95.     
  96.     txt = "  #  Red Green Blue" & vbCrLf
  97.     For i = 0 To num_entries - 1
  98.         istr = Format$(i)
  99.         rstr = Format$(palentry(i).peRed)
  100.         gstr = Format$(palentry(i).peGreen)
  101.         bstr = Format$(palentry(i).peBlue)
  102.         txt = txt & _
  103.             Space$(3 - Len(istr)) & istr & ":" & _
  104.             Space$(4 - Len(rstr)) & rstr & _
  105.             Space$(6 - Len(gstr)) & gstr & _
  106.             Space$(5 - Len(bstr)) & bstr & vbCrLf
  107.     Next i
  108.  
  109.     EntryText.Text = txt
  110. End Sub
  111.  
  112.  
  113.  
  114. Private Sub Form_Load()
  115.     ' Make sure the screen supports palettes.
  116.     If Not GetDeviceCaps(hdc, RASTERCAPS) And RC_PALETTE Then
  117.         Beep
  118.         MsgBox "This monitor does not support palettes.", _
  119.             vbCritical
  120.         End
  121.     End If
  122.  
  123.     ShowEntries
  124. End Sub
  125.  
  126.  
  127.  
  128. Private Sub Form_Resize()
  129. Dim wid As Single
  130.  
  131.     EntryText.Move ScaleWidth - EntryText.Width, _
  132.         0, EntryText.Width, ScaleHeight
  133.     
  134.     wid = EntryText.Left - 20
  135.     If wid < 100 Then wid = 100
  136.     Pict.Move 0, 0, wid, ScaleHeight
  137. End Sub
  138.  
  139. Private Sub mnuFileExit_Click()
  140.     Unload Me
  141. End Sub
  142.  
  143. Private Sub mnuFileLoad_Click()
  144. Dim fname As String
  145.  
  146.     ' Allow the user to pick a file.
  147.     On Error Resume Next
  148.     FileDialog.filename = "*.BMP;*.ICO;*.RLE;*.WMF;*.DIB"
  149.     FileDialog.Flags = cdlOFNFileMustExist + cdlOFNHideReadOnly
  150.     FileDialog.ShowOpen
  151.     If Err.Number = cdlCancel Then
  152.         Exit Sub
  153.     ElseIf Err.Number <> 0 Then
  154.         Beep
  155.         MsgBox "Error selecting file.", , vbExclamation
  156.         Exit Sub
  157.     End If
  158.     On Error GoTo 0
  159.     
  160.     MousePointer = vbHourglass
  161.     DoEvents
  162.     
  163.     fname = Trim$(FileDialog.filename)
  164.     FileDialog.InitDir = Left$(fname, Len(fname) _
  165.         - Len(FileDialog.FileTitle) - 1)
  166.  
  167.     ' Load the picture.
  168.     Pict.Picture = LoadPicture(fname)
  169.  
  170.     Caption = "GetEntry [" & fname & "]"
  171.  
  172.     ' Update the list of colors.
  173.     ShowEntries
  174.     MousePointer = vbDefault
  175. End Sub
  176.  
  177.